Optional Vectors.f

Requires FixedPoint.f
Requires A.f
Requires Tools.f
Requires Dorothy.f
Only Forth Definitions

type: vector
   fixed.field x
   fixed.field y
   fixed.field z
end-type

{
\ Interpret up to 3 values and place in dictionary - any code is allowed so long as it adds 0 to 3 items to the stack.
: coords   ( stopper -- addr )
  locals| stopper |
  a@ >r  state @ >r   state off
    here 3 cells /allot
    a!
    a@ >r depth >r
      stopper parse evaluate
    depth r> - dup >r reverse r> 0 ?do !a+ loop
    r>
  r> state !   r> a!  ;

\ Simple literal-vector / literal-array structure creator
: Vector:
  create  [char] ; coords drop ;

Vector: tempv   0.0 0.0 0.0  ;
}

method: vector.construct   ( x y z -- )
   z.! y.! x.! ;
' vector.construct >delegate vector construct

\ : 2v!   >r swap r> 2! ;
icode vector.2!
  0 [ebp] eax mov
  4 [ebp] ecx mov
  eax 4 [ebx] mov
  ecx 0 [ebx] mov
  8 [ebp] ebx mov
  12 # ebp add
  ret end-code

\ : 2v+!   dup >r 2v@ 2+ r> 2v! ;
icode vector.2+!
  0 [ebp] eax mov
  4 [ebp] ecx mov
  eax 4 [ebx] add
  ecx 0 [ebx] add
  8 [ebp] ebx mov
  12 # ebp add
  ret end-code


: vector.2?   dup x.? y.? ;

-dorothy
: vector.2@f   @+ p>f @ p>f ;
+dorothy

: vector.3@   int.3@ ;

\ : 3v!   dup >r 8 + ! r@ cell+ ! r> ! ;
code vector.3!
  0 [ebp] eax mov
  4 [ebp] ecx mov
  eax 8 [ebx] mov
  ecx 4 [ebx] mov
  8 [ebp] eax mov
  eax 0 [ebx] mov
  12 [ebp] ebx mov
  16 # ebp add
  ret end-code

\ : 3v+!   dup >r 8 + +! r@ cell+ +! r> +! ;
code vector.3+!
  0 [ebp] eax mov
  4 [ebp] ecx mov
  eax 8 [ebx] add
  ecx 4 [ebx] add
  8 [ebp] eax mov
  eax 0 [ebx] add
  12 [ebp] ebx mov
  16 # ebp add
  ret end-code

: vector.3?   dup x.? dup y.? z.? ;

-dorothy
: vector.3@f   @+ p>f  @+ p>f @ p>f ;

: xy>ang   ( x. y. -- ang. )
   p>f p>f f/ fatan r>d f>p ;

: vector.2ang   ( vector -- ang. )
  @+ swap @ xy>ang ;

: ang>xy ( .angle .length -- x. y. )
   p>f
   p>f  ( f: length angle )
   f2dup ( f: length angle length angle )
   sin f* f>p
   cos f* f>p ;
+dorothy

method: vector.2scale ( x. y. vector -- )
   y.@ p* y.!  x.@ p* x.! ;

method: vector.3scale ( x. y. z. dest -- )
   z.@ p* z.!   y.@ p* y.!   x.@ p* x.! ;

: 2mul ( x. y. x. y. -- x. y. )
   rot p* >r p* r> ;

: 3mul ( x. y. z. x. y. z. -- x. y. z. )
   3 roll p* >r
   rot p* >r p* r> r> ;

-dorothy
: 2len  ( x. y. -- n. )
   2p>f fdup f* fswap fdup f* f+ fsqrt f>p ;
+dorothy

macro: vector.2length ( addr -- .n )   vector.2@ 2len ;

method: vector.2normalize ( -- )
   1.0 2length dup if p/ 2scale else 2drop then ;

: vector.2negate   dup @ negate !+ dup @ negate !+ drop ;
: vector.3negate   dup @ negate !+ dup @ negate !+ dup @ negate !+ drop ;

: 2rotate   ( x. y. angle. -- x. y. )
  dup pcos swap psin locals| sin(ang) cos(ang) y x |
  x cos(ang) p* y sin(ang) p* -
  x sin(ang) p* y cos(ang) p* + ;

\ 2+ and 2- are obsolete Forth words.  I'm redefining them to something useful.

-? icode 2+  ( x. y. x. y. -- x. y. )
   0 [ebp] eax mov                  \ get d2-lo
   eax 8 [ebp] add                  \ add d1-lo
   4 [ebp] ebx add                  \ add d1-hi
   8 # ebp add                      \ and clean up stack
   ret end-code

-? icode 2-   ( x. y. x. y. -- x. y. )
   0 [ebp] eax mov
   ebx 4 [ebp] sub
   eax 8 [ebp] sub
   4 [ebp] ebx mov
   8 # ebp add
   ret end-code

-? icode 3+   ( x. y. z. x. y. z. -- x. y. z. )
   0 [ebp] eax mov
   4 [ebp] ecx mov
   ebx 8 [ebp] add
   eax 12 [ebp] add
   ecx 16 [ebp] add
   8 [ebp] ebx mov
   12 # ebp add
   ret end-code

-? icode 3-   ( x. y. z. x. y. z. -- x. y. z. )
   0 [ebp] eax mov
   4 [ebp] ecx mov
   ebx 8 [ebp] sub
   eax 12 [ebp] sub
   ecx 16 [ebp] sub
   8 [ebp] ebx mov
   12 # ebp add
   ret end-code

macro: 2proximity  ( x. y. x. y. -- n. )    2- 2len ;

: 2negate  negate swap negate swap ;

